home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1997 #3 / Amiga Plus CD - 1997 - No. 03.iso / pd / programmierung / alienbreed3d2_src / amos / transobj.amos / transobj.amosSourceCode
AMOS Source Code  |  1997-01-31  |  4KB  |  152 lines
  1. Screen Open 7,640,24,2,Hires : Wait Vbl : Curs Off : Flash Off : Extension_12_0380 -1
  2. Palette $8,$FF0 : Paper 0 : Pen 1 : Ink 1 : Box 0,4 To 639,20
  3.  
  4. Reserve As Work 14,640*640+12
  5. 'Reserve As Work 13,4096 
  6. Reserve As Work 12,40960
  7. Screen Open 1,640,32,2,Lowres
  8. Curs Off : Flash Off : Cls 0
  9. Colour 1,$FFF
  10. Dim CO(63),R(255),G(255),B(255),PR(31),PG(31),PB(31)
  11. Global WOF,HOF,CO(),R(),G(),B(),PR(),PG(),PB()
  12. Trap Bload "ab3:includes/256pal",Start(14)
  13. If Errtrap
  14.    Screen To Front 7 : Screen 7
  15.    Locate 1,1 : Print Space$(78)
  16.    Locate 1,1 : Centre "Unable to load 'ab3:includes/256pal'"
  17.    Wait Key 
  18.    Edit 
  19. End If 
  20. S=Start(14)
  21. For A=0 To 255
  22.    R(A)=Deek(S) : Add S,2
  23.    G(A)=Deek(S) : Add S,2
  24.    B(A)=Deek(S) : Add S,2
  25. Next 
  26.  
  27. Repeat 
  28.    F$=Fsel$("ab3:graphics/","","Load Object Graphics")
  29.    If F$="" Then Exit 
  30.    Screen Open 0,640,640,32,Lowres
  31.    Curs Off : Flash Off : Cls 0
  32.    Wait Vbl 
  33.    ' Load Iff F$,0
  34.    Trap Load Iff F$
  35.    If Errtrap
  36.       Screen To Front 7 : Screen 7
  37.       Locate 1,1 : Print Space$(78)
  38.       Locate 1,1 : Centre "Unable to load '"+F$+"'"
  39.       Wait Key 
  40.       Edit 
  41.    End If 
  42.    
  43.    
  44.    Trap Bload F$,Start(14)
  45.    If Errtrap
  46.       Screen To Front 7 : Screen 7
  47.       Locate 1,1 : Print Space$(78)
  48.       Locate 1,1 : Centre "Unable to load '"+F$+"'"
  49.       Wait Key 
  50.       Edit 
  51.    End If 
  52.    S=Hunt(Start(14) To Start(14)+10000,"CMAP")+8
  53.    For A=0 To 31
  54.       PR(A)=Peek(S) : Add S,1
  55.       PG(A)=Peek(S) : Add S,1
  56.       PB(A)=Peek(S) : Add S,1
  57.    Next 
  58.    
  59.    For A=0 To 31 : CO(A)=Colour(A)
  60.    Next 
  61.    Screen 7 : Screen To Front 7
  62.    Locate 1,1 : Print Space$(78) : Locate 1,1 : Input "Screen Width: ";WOS
  63.    Locate 1,1 : Print Space$(78) : Locate 1,1 : Input "Number of frames: ";NOF
  64.    Locate 1,1 : Print Space$(78) : Locate 1,1 : Input "Width of each frame: ";WOF
  65.    Locate 1,1 : Print Space$(78) : Locate 1,1 : Input "Height of each frame: ";HOF
  66.    Curs Off 
  67.    X=0 : Y=0
  68.    For A=0 To NOF-1
  69.       CONVERT[Start(14)+6+A*WOF*HOF,X,Y]
  70.       X=X+WOF : If X+WOF>WOS Then X=0 : Add Y,HOF
  71.    Next 
  72.    F$=Fsel$("ab3:includes/","","Save raw data file")
  73.    If F$="" Then Exit 
  74.    PSAVE[F$,NOF]
  75.    Screen 7 : Locate 1,1 : Print Space$(78) : Locate 1,1 : Centre "All done, select another file, or cancel to quit."
  76. Until 0
  77.  
  78. Procedure PSAVE[M$,NO]
  79.    L=(NO*WOF*HOF)-1
  80.    '
  81.    T=0
  82.    P=Start(12)
  83.    '
  84.    
  85.    Screen 1
  86.    S=Start(14)
  87.    Doke S,NO
  88.    Doke S+2,WOF
  89.    Doke S+4,HOF
  90.    Add S,6
  91.    Add S,L
  92.    Trap Bsave M$+".dat",Start(14) To S
  93.    If Errtrap
  94.       Screen To Front 7 : Screen 7
  95.       Locate 1,1 : Print Space$(78)
  96.       Locate 1,1 : Centre "Unable to save '"+M$+".dat'"
  97.       Wait Key 
  98.       Edit 
  99.    End If 
  100.    N=Start(12)
  101.  
  102.    Screen 7 : Locate 1,1 : Print Space$(78) : Locate 10,1 : Print "Calculating palette"
  103.  
  104.    For A=0 To 31
  105.       For Q=0 To 255
  106.  
  107.          Locate 32,1 : Print Using "(###.##% complete)";(A*256+Q)/81.92
  108.  
  109.          R=PR(A)+R(Q) : G=PG(A)+G(Q) : B=PB(A)+B(Q)
  110.          R=Min(255,R) : G=Min(255,G) : B=Min(255,B)
  111.          
  112.          DQ=10000000
  113.          TC=0
  114.          For Z=0 To 255
  115.             DR=Abs(R-R(Z))
  116.             DG=Abs(G-G(Z))
  117.             DB=Abs(B-B(Z))
  118.             
  119.             ND=(DR*3)+(DG*3)+(DB*3)
  120.             If ND<DQ Then DQ=ND : TC=Z
  121.          Next 
  122.          
  123.          Poke N,TC
  124.          Add N,1
  125.       Next 
  126.    Next 
  127.    
  128.    Trap Bsave M$+".256pal",Start(12) To N
  129.    If Errtrap
  130.       Screen To Front 7 : Screen 7
  131.       Locate 1,1 : Print Space$(78)
  132.       Locate 1,1 : Centre "Unable to save '"+M$+".256pal'"
  133.       Wait Key 
  134.       Edit 
  135.    End If 
  136. End Proc
  137. '
  138. Procedure CONVERT[ST,OX,OY]
  139.  
  140.    Screen 7 : Locate 1,1 : Print Space$(78) : Locate 1,1
  141.    Centre "Converting data..."
  142.  
  143.    Screen 0
  144.    Pen 0
  145.    For X=OX To OX+WOF-1
  146.       For Y=OY To OY+HOF-1
  147.          C= Extension_12_044C(X,Y)
  148.          Poke ST,C
  149.          Add ST,1
  150.           Extension_12_036E X,Y,0
  151.    Next : Next 
  152. End Proc